perm filename GRAPH3.LSP[TIM,LSP] blob
sn#769836 filedate 1984-09-13 generic text, type C, neo UTF8
COMMENT ā VALID 00006 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 Routines to plot performance of the implementations
C00012 00003 Routines to plot performance of the implementations (hardcopy)
C00016 00004 For each benchmark:
C00023 00005 (declare (special *logp* *rawp*))
C00031 00006 This is for hardcopy:
C00033 ENDMK
Cā;
;;; Routines to plot performance of the implementations
(eval-when (load)
(fasload ddmid fas dsk (sys rod)))
(declare (special *chan* *points* *best* *scale* *vertical-lines* *filterp*)
(setq defmacro-for-compiling ())
(mapex t)
(*expr ddinit screen erase line dpyup gddchn rddchn))
;;; *chan* is a global variable containing the channel number
(setq *scale* 1.0)
(setq *vertical-lines* ())
;;; Places a vertical tick yeps high at (x,y)
(defun v-tick (x y yeps)
(let ((half-yeps (//$ yeps 2.0)))
(line x (-$ y half-yeps) x (+$ y half-yeps))))
;;; Places a horizontal tick xeps high at (x,y)
(defun h-tick (x y xeps)
(let ((half-xeps (//$ xeps 2.0)))
(line (-$ x half-xeps) y (+$ x half-xeps) y)))
;;; Places a small `x' at a point
(defun draw-x (x y xeps yeps)
(let ((half-xeps (//$ xeps 2.0))
(half-yeps (//$ yeps 2.0)))
(line (-$ x half-xeps) (+$ y half-yeps)
(+$ x half-xeps) (-$ y half-yeps))
(line (-$ x half-xeps) (-$ y half-yeps)
(+$ x half-xeps) (+$ y half-yeps))))
;;; This takes a set of points of the form:
;;; (...(y1...yn)...) = L
;;; sets up the co-ordinates for the graph. If L is n long, then
;;; the x-axis goes from 0 to n. The y-axis goes from the minimum of yi to the
;;; maximum of yi.
(defmacro add-set (x set)
`(cond ((not (member-set ,x ,set))
(push ,x ,set))))
(defun member-set (x set)
(let ((cx (car x)))
(do ((set set (cdr set)))
((null set) ())
(cond ((= cx (caar set))
(return t))))))
(defun set-difference (x y)
(do ((x x (cdr x))
(points ()))
((null x) points)
(cond ((member-set (car x) y))
(t (push (car x) points)))))
(defmacro first-not-null (l count)
(let ((g (gensym)))
`(do ((l ,l (cdr l))
(,g ,count (1+ ,g)))
((or (null l)
(not (null (car l))))
(setq ,count ,g)
l))))
(defmacro incf (x)
`(setq ,x (1+ ,x)))
(defmacro adjust-fun (x)
`(let ((x ,x))
(and (numberp x)(+$ 1.0 x))))
(defmacro graph-macro (line ddinit dpyup screen erase vtick htick supplied-ymax)
`(cond ((null points)
(terpri)
(princ "Not enough points")
(terpri))
(t (let ((fhx (+$ 1.0 (float (length points))))
(ymin (car (car points)))
(ymax (cond ((> supplied-ymax 0.0)
supplied-ymax)
(t (car (car points)))))
(fhy 0.0)
(xeps 0.0) (yeps 0.0))
(do ((l points (cdr l)))
((null l))
(do ((p (car l) (cdr p)))
((null p))
(cond ((numberp (car p))
(cond ((numberp ymin)
(cond ((lessp (car p) ymin)
(setq ymin (car p)))
((> supplied-ymax 0.0))
((greaterp (car p) ymax)
(setq ymax (car p)))))
(t (setq ymin (car p))
(setq ymax (car p))))))))
(setq fhy (+$ 1.0 (*$ 1.1 (-$ ymax ymin))))
(setq xeps (//$ fhx 100.0))
(setq yeps (//$ fhy 100.0))
(setq *chan* (gddchn -1))
(,ddinit)
(,screen 0.5 0.5 (*$ 1.2 (*$ (float *scale*) fhx))
(*$ 1.2 (*$ (float *scale*) fhy)))
(,erase *chan*)
; (,line 1.0 1.0 1.0 fhy)
(,line 1.0 1.0 fhx 1.0)
(let ((ox 1.0)
(oy 0.0))
(do ((l points (cdr l))
(n 2 (1+ n)))
((null l)
(dpyup *chan*))
(setq ox (float n))
(setq oy (adjust-fun (car (car l))))
(do ((p (cdar l) (cdr p))
(nx (float n))
(ny 0.0))
((null p)
(cond (*vertical-lines*
(,line ox oy nx ny))
(t
(,vtick ox 1.0 yeps))))
(cond ((not (null (car p)))
(setq ny (adjust-fun (car p)))
(cond (*vertical-lines*
(,line ox oy nx ny))
(t (,vtick ox 1.0 yeps)))
(setq ox nx oy ny))))))
(let ((nl 2)(nm 3)(plotted-points ())(all-points ()))
(do ((l (first-not-null points nl)
(progn (incf nl) (first-not-null (cdr l) nl)))
(m (first-not-null (cdr points) nm)
(progn (incf nm) (first-not-null (cdr m) nm))))
((null m)
(let ((unplotted-points
(set-difference
all-points plotted-points)))
(cond (unplotted-points
(do ((p unplotted-points (cdr p)))
((null p) t)
(cond ((eq (cadr (car p)) 'real)
(,htick 1.0 (caddr (car p)) xeps))
((eq (cadr (car p)) 'cpu)
(,htick (+$ 1.0 fhx)
(caddr (car p)) xeps)))
(draw-x (car (car p)) (caddr (car p))
xeps yeps)))))
(,dpyup *chan*)
*chan*)
(do ((template template (cdr template))
(x (car l) (cdr x)))
((null x))
(cond ((numberp (car x))
(cond ((or (null (car template))
(eq (car template) 'real))
(,htick 1.0 (adjust-fun (car x)) xeps))
((eq (car template) 'cpu)
(,htick (+$ 1.0 fhx) (adjust-fun (car x)) xeps))))))
(cond ((caar l)
(add-set
`(,(float nl) ,(car template)
,(adjust-fun (caar l)))
all-points)))
(do ((x (car l) (cdr x))
(template template (cdr template))
(y (car m) (cdr y)))
((or (null x)
(null y)) t)
(cond ((car y)
(add-set
`(,(float nm) ,(cadr template)
,(adjust-fun (car y)))
all-points)))
(cond ((and (numberp (car x))
(numberp (car y)))
(add-set
`(,(float nl) ,(car template) ,(adjust-fun (car x)))
plotted-points)
(add-set
`(,(float nm) ,(car template) ,(adjust-fun (car y)))
plotted-points)
(cond ((or (null template)
(eq (car template) 'real))
(,htick 1.0 (adjust-fun (car y)) xeps))
((eq (car template) 'cpu)
(,htick (+$ 1.0 fhx) (adjust-fun (car y)) xeps)))
(,line (float nl) (adjust-fun (car x))
(float nm) (adjust-fun (car y))))))))))))
(defun init ()
(erase *chan*)
(rddchn *chan*))
(defun graph (points &optional (template ())
(supplied-ymax -1.0))
(declare (flonum fhx fhy xeps yeps))
(graph-macro line ddinit dpyup screen erase v-tick h-tick supplied-ymax))
;;; Routines to plot performance of the implementations (hardcopy)
(eval-when (load)
(fasload god fas dsk (sys ml)))
(declare (special *chan* *points* *best* *scale*)
(setq defmacro-for-compiling ())
(mapex t)
(*expr ddinit-g screen-g erase-g line-g dpyup-g gddchn-g rddchn-g))
;;; *chan* is a global variable containing the channel number
(setq *scale* 1.0)
;;; Places a vertical tick yeps high at (x,y)
(defun v-tick-g (x y yeps)
(let ((half-yeps (//$ yeps 2.0)))
(line-g x (-$ y half-yeps) x (+$ y half-yeps))))
;;; Places a horizontal tick xeps high at (x,y)
(defun h-tick-g (x y xeps)
(let ((half-xeps (//$ xeps 2.0)))
(line-g (-$ x half-xeps) y (+$ x half-xeps) y)))
;;; This takes a set of points of the form:
;;; (...(y1...yn)...) = L
;;; sets up the co-ordinates for the graph. If L is n long, then
;;; the x-axis goes from 0 to n. The y-axis goes from the minimum of yi to the
;;; maximum of yi.
(defun graph-g (points &optional (template ())
(supplied-ymax -1.0))
(declare (flonum fhx fhy xeps yeps))
(graph-macro line-g ddinit-g dpyup-g screen-g progn v-tick-g h-tick-g supplied-ymax))
;;; For each benchmark:
;;;(...(benchmark
;;; ((blankline))
;;; ((indent 1) "Benchmark 3" (entry (f entry)))
;;; ((center) "Random Text"))...)
;;;
;;; For each implementation:
;;;(...(impl "Top-row Information")...)
(declare (special *data* *benchmarks* *all-implementations*
*impl-order* *invert* *sortp*
*all-implementations-flattened* *max-length*
*selectors* *subset-relationships* *all-benchmarks*))
(declare (mapex t))
(declare (special *benchmark-info*))
(defun get-bench-data (bench impl)
(cadr (assq impl (cdr (assoc bench *data*)))))
(defun filter-to-show-same (l)
(cond ((not *filterp*) l)
(t (let ((template
(do ((templ
(mapcar #'(lambda (()) t)
(car l)))
(l l (cdr l)))
((null l) templ)
(do ((x (car l) (cdr x))
(templ templ (cdr templ)))
((null templ))
(cond ((null (car x))
(setf (car templ) ())))))))
(do ((x l (cdr x)))
((null x)
(cond (*sortp*
(unzip (sort (zip l *impl-order*) #'avelessp)))
(t l)))
(do ((y (car x) (cdr y))
(templ template (cdr templ)))
((null y))
(cond ((null (car templ))
(setf (car y) ())))))))))
(defun average(l)
(do ((l (car l) (cdr l))
(ave 0.0)
(n 0))
((null l)(//$ ave (float n)))
(cond ((numberp (car l))
(setq ave (+$ (float (car l)) ave))
(setq n (1+ n))))))
(defun avelessp (x y)
(lessp (average x)(average y)))
(defun zip (l1 l2)
(mapcar #'cons l1 l2))
(defun unzip (l)
(setq *impl-order*
(mapcar #'cdr l))
(mapcar #'car l))
(defun invert (l)
(let ((new (mapcar #'(lambda (()) ()) (car l))))
(do ((l l (cdr l)))
((null l)(flush-lists-of-nil new))
(do ((cl (car l) (cdr cl))
(x new (cdr x)))
((null cl))
(setf (car x) `(,(car cl) .,(car x)))))))
(defun possibly-invert (l)
(cond (*invert* (invert l))
(t l)))
(defmacro all-nil (l)
`(do ((l ,l (cdr l)))
((null l) t)
(cond ((car l) (return ())))))
(defun flush-lists-of-nil (l)
(cond ((not *filterp*) l)
(t (let* ((dyke (cons () *impl-order*))
(front dyke))
(prog1
(mapcan #'(lambda (x)
(cond ((all-nil x)
(setf (cdr dyke) (cddr dyke))
())
(t (setq dyke (cdr dyke))
(ncons x))))
l)
(setq *impl-order* (cdr front)))))))
(declare (special *logp* *rawp*))
;;; Here's some specials and what they do:
;;; *rawp* - if T, then raw data it plotted, otherwise scaled to best
;;; *logp* - if T, then logarithmic scale on y-axis
;;; *invert* - if T, then x-axis is benchmarks, otherwise implementations
;;; *impl-order* - when implementations are on the x-axis, this returns
;;; the order in which they are placed
;;; *sortp* - if T, graphs are sorted.
;;; *filterp* - if T, filters out missing points from all curves.
(setq *logp* t *rawp* t)
(setq *invert* t *sortp* ())
(setq *filterp* ())
(defun graph-impls-real (implementations)
(graph-impls implementations 'real))
(defun graph-impls-cpu (implementations)
(graph-impls implementations 'cpu))
(defmacro graph-impls-macro (grapher init)
`(let ((best-alist
(or *logp* *rawp*
(mapcar #'(lambda (bench)
`(,(car bench)
,(find-best (car bench) (caddr bench)
implementations
type)))
*all-benchmarks*))))
,init
(setq *impl-order* (cond (*invert* (mapcar #'car *all-benchmarks*))
(t implementations)))
(,grapher
(filter-to-show-same
(possibly-invert
(mapcar #'(lambda (impl)
(let ((info
(make-a-column impl best-alist type)))
info))
implementations)))
(cond ((= (length implementations) 2)
'(real cpu))
(t ())))
*chan*))
(defun graph-impls (implementations type)
(graph-impls-macro graph
(and (boundp '*chan*) (init))))
(defmacro graph-impl-macro (grapher init)
`(progn
,init
(setq *impl-order* (cond (*invert* (mapcar #'car *all-benchmarks*))
(t (ncons implementation))))
(let ((points
(possibly-invert
(list
(let ((info
(make-a-column implementation () 'real)))
info)
(let ((info
(make-a-column implementation () 'cpu)))
info)))))
(let ((temp (cond (*invert* '(cpu real))
(t '(real cpu)))))
(cond (absp (,grapher points temp #.(log 2900.0)))
(t (,grapher points temp)))))
*chan*))
(defun graph-impl (implementation &optional (absp ()))
(graph-impl-macro graph (and (boundp '*chan*) (init))))
(defmacro float-it (x)
`(setq ,x (float ,x)))
(defun make-a-column (impl best-alist type)
(mapcar
#'(lambda (bench)
(let ((info
(funcall (caddr bench)
(get-bench-data
(find-superset-bench (car bench))
(find-superset-impl impl))))
(best (or *logp* *rawp*
(cadr (assq (car bench) best-alist)))))
(caseq type
(real
(let ((entry (real-time impl info)))
(cond (*logp*
(cond ((and
(numberp entry)
(progn (float-it entry)
(lessp 0.0 entry)))
(log (+$ 1.0 entry)))
(t ())))
(t
(cond
((numberp entry)
(cond
(*rawp* entry)
((numberp best)
(//$ (float entry) best))
(t ()))))))))
(cpu
(let ((entry (cpu-time impl info)))
(cond
(*logp*
(cond
((and
(numberp entry)
(progn
(float-it entry)
(lessp 0.0 entry)))
(log (+$ 1.0 entry)))
(t ())))
(t
(cond
((numberp entry)
(cond (*rawp* entry)
((numberp best)
(//$ (float entry) best))
(t ()))))))))
(t ()))))
*all-benchmarks*))
(defun find-best (bench fun impls type)
(let ((data
(mapcan #'(lambda (impl)
(let ((info
(funcall fun
(get-bench-data
(find-superset-bench bench)
(find-superset-impl impl)))))
(caseq type
(real
(let ((entry (real-time impl info)))
(cond ((numberp entry)
(ncons (float entry))))))
(cpu
(let ((entry (cpu-time impl info)))
(cond ((numberp entry)
(ncons (float entry))))))
(t ()))))
impls)))
(do ((data (cdr data) (cdr data))
(best (car data)))
((null data) best)
(cond ((lessp (car data) best)
(setq best (car data)))))))
(defun find-superset-bench (bench)
(do ((b *subset-relationships* (cdr b)))
((null b) ())
(cond ((memq bench (cadr (car b)))
(return (car (car b)))))))
(defun find-superset-impl (impl)
(cadr (assq impl *all-implementations-flattened*)))
;;; This is for hardcopy:
(defun graph-impls-real-g (implementations)
(graph-impls-g implementations 'real))
(defun graph-impls-cpu-g (implementations)
(graph-impls-g implementations 'cpu))
(defun graph-impls-g (implementations type)
(graph-impls-macro graph-g
(and (boundp '*chan*) (init))))
(defun graph-impl-g (implementation &optional (absp ()))
(graph-impl-macro graph-g (and (boundp '*chan*) (init))))